﻿'---------------------------------------------------------------------
'    Copyright ©2010 CAOTEK
'    Ce code source fait partie du logiciel AEM2010.
'    Auteur - Thien Phuoc Cao : phuoc@caotek.fr

Imports System.Environment
Module Module1
    ' Paramètres de l'application
    Private ctDSN_AEM As String
    Private szSQL As String
    Private rs As ADODB.Recordset = Nothing
    Dim mailman As New Chilkat.MailMan()
    Dim iDeb As Integer
    Dim iFin As Integer

    Sub Main()

        Dim bundle As Chilkat.EmailBundle
        Dim email As Chilkat.Email
        Dim iCrees As Integer = 0

        ' lire les paramètres de l'application
        ctDSN_AEM = My.Settings.ConnectionBD

        ' tester la connection avec la BD MySQL
        If IsConnectionOK() = False Then
            ' fin programme
            End
        End If

        ' Paramètres de lecture POP3
        mailman.MailHost = My.Settings.MailHost
        mailman.PopUsername = My.Settings.PopUsername
        mailman.PopPassword = My.Settings.PopPassword
        ' Unlocks the component Chilkat : 1-Developer Email License
        If (mailman.UnlockComponent("CAESDUMAILQ_ReHqeuNs6R0e") <> True) Then
            ExecQuery(ctDSN_AEM, "CALL spINS_T_LOG('aem_CB','Chilkat Component unlock failed');")
            End
        End If


        '  Copy the all email from the user's POP3 mailbox
        '  into a bundle object.  The email remains on the server.
        bundle = mailman.CopyMail()

        If (bundle Is Nothing) Then
            ExecQuery(ctDSN_AEM, "CALL spINS_T_LOG('aem_CB','" & nq(mailman.LastErrorText) & "');")
            End
        End If

        ' Loop over the bundle and display the FROM and SUBJECT of each.
        Dim i As Integer
        For i = 0 To bundle.MessageCount - 1
            email = bundle.GetEmail(i)
            ' est-ce un ticket CB ?
            If InStr(email.Body, "CARTE BANCAIRE") > 0 Then
                ' est-ce un ticket d'erreur ? oui, transférer le ticket à la comptabilité par email 
                If InStr(1, email.Body, "Erreur :") > 0 Then
                    Call TraiterTicketErreur(email)
                Else
                    If InStr(1, email.Body, "Abonnement") > 0 Then
                        ' oui, traiter le ticket abonnement
                        Call TraiterTicketAbonnement(email)
                    Else
                        ' oui, traiter le ticket abonnement
                        Call TraiterTicketComptant(email)
                    End If
                    ' si OK, increment the counter
                    iCrees += 1
                End If
            End If
            ' supprimer le ticket
            If (mailman.DeleteEmail(email) <> True) Then
                ExecQuery(ctDSN_AEM, "CALL spINS_T_LOG('aem_CB','" & Left(nq(mailman.LastErrorText), 512) & "');")
            End If
        Next

        ' Disconnect from the POP3 server.
        mailman.Pop3EndSession()

        ' Ecrire logs : Fin de traitement
        If i > 0 Then
            ExecQuery(ctDSN_AEM, "CALL spINS_T_LOG('aem_CB','Fin traitement CB : " & i & " tickets lus, " & iCrees & " réglements créés');")
        End If

    End Sub

    Public Function nq(ByVal c As String) As String
        ' remplace les quotes par ''
        On Error Resume Next
        nq = Replace(c, "'", "\'")

    End Function

    Private Sub TraiterTicketComptant(email As Chilkat.Email)
        Dim ticketDate As String
        Dim ticketReference As String
        Dim Date_ope As Date
        Dim cd_cli As Integer

        ' date d'opération
        ticketDate = GetTicketDate(email)
        Date_ope = Date.ParseExact(Left(ticketDate, 10), "dd/MM/yyyy", System.Globalization.DateTimeFormatInfo.InvariantInfo)

        ' référence
        ticketReference = GetRefCommande(email)
        cd_cli = Left(ticketReference, 6)

        ' Créer une écriture de crédit dans le compte du client
        szSQL = "CALL spINS_ELEVES_CREDIT_WEB(" & cd_cli & ",'" & Format(Date_ope, "yyyy/MM/dd") & "'," & GetTicketMontant(email) & ",'');"
        ExecQuery(ctDSN_AEM, szSQL)

        ' copie le ticket dans la table tickets_cb
        szSQL = "CALL spINS_TICKETS_CB('" & GetTicketEmail(email) & "','" & email.Subject & "','" & ticketDate & "','" & ticketReference & "'," & GetTicketMontant(email) & ",'" & GetTicketAutorisation(email) & "','');"
        ExecQuery(ctDSN_AEM, szSQL)

    End Sub

    Private Sub TraiterTicketAbonnement(email As Chilkat.Email)
        Dim ticketDate As String
        Dim ticketReference As String
        Dim firstDatePrelev As Date
        Dim nextDatePrelev As Date
        Dim nextMontantPrelev As Decimal
        Dim Date_ope As Date
        Dim cd_cli As Integer

        ' date d'opération
        ticketDate = GetTicketDate(email)
        Date_ope = Date.ParseExact(Left(ticketDate, 10), "dd/MM/yyyy", System.Globalization.DateTimeFormatInfo.InvariantInfo)

        ' Si ticket abonnement : la référence est suivie de la date du 1er prélèvement
        ' ex: Ref commande:123456/04-11-2013
        ticketReference = GetRefCommande(email)
        cd_cli = Left(ticketReference, 6)
        firstDatePrelev = Date.ParseExact(Mid(ticketReference, 8, 10), "dd-MM-yyyy", System.Globalization.DateTimeFormatInfo.InvariantInfo)

        ' prochaine date et montant du prélèvement
        iDeb = InStr(email.Body, "Prochain")
        If iDeb > 0 Then
            nextDatePrelev = Date.ParseExact(Mid(email.Body, iDeb + 24, 10), "dd/MM/yyyy", System.Globalization.DateTimeFormatInfo.InvariantInfo)
            iDeb = InStr(iDeb, email.Body, ":") + 1
            iFin = InStr(iDeb, email.Body, "EUR")
            nextMontantPrelev = CDec(Replace(Mid(email.Body, iDeb, iFin - iDeb), Chr(&HA0), " "))
        Else
            nextDatePrelev = Nothing
            nextMontantPrelev = 0
        End If


        ' Cas du 1er prélèvement :  MT du prochain prélèv <>0 et date opération égale date du 1er prél à un jour près
        If nextMontantPrelev <> 0 And Math.Abs(DateDiff("d", firstDatePrelev, Date_ope)) <= 1 Then
            ' Si le paiement est vers minuit, un décalage de 1 jour entre la date de premier prélev et la date d'opération peut arriver
            ' Créer la 1ère écriture de crédit dans le compte du client
            szSQL = "CALL spINS_ELEVES_CREDIT_WEB(" & cd_cli & ",'" & Format(firstDatePrelev, "yyyy/MM/dd") & "'," & GetTicketMontant(email) & ",'" & _
                     ticketReference & "-1-OK');"
            ExecQuery(ctDSN_AEM, szSQL)
            ' Créer la 2ème écriture de crédit dans le compte du client
            szSQL = "CALL spINS_ELEVES_CREDIT_WEB(" & cd_cli & ",'" & Format(DateAdd("m", 1, firstDatePrelev), "yyyy/MM/dd") & "'," & nextMontantPrelev & ",'" & _
                     ticketReference & "-2');"
            ExecQuery(ctDSN_AEM, szSQL)
            ' Créer la 3ème écriture de crédit dans le compte du client
            szSQL = "CALL spINS_ELEVES_CREDIT_WEB(" & cd_cli & ",'" & Format(DateAdd("m", 2, firstDatePrelev), "yyyy/MM/dd") & "'," & nextMontantPrelev & ",'" & _
                     ticketReference & "-3');"
            ExecQuery(ctDSN_AEM, szSQL)
        Else
            'Pour les paiement en N fois, MT paiement de l'échéance, mettre à jour la date prévisionnelle
            If nextMontantPrelev <> 0 Then
                ' Cas du 2ème Prélèvement : MT du prochain (prélèv <>0) et il y a une date de prochain prélèv
                ' Ajoute "-OK" dans la référence abonnement pour indiquer qu'il est prélevé
                szSQL = "CALL spUPD_ELEVES_CREDIT_WEB(" & cd_cli & ",'" & Format(DateAdd("m", 1, firstDatePrelev), "yyyy/MM/dd") & "'," & GetTicketMontant(email) & ",'" & _
                         ticketReference & "-2');"
                ExecQuery(ctDSN_AEM, szSQL)
            Else
                ' Cas du dernier Prélèvement : MT du prochain (prélèv <>0)
                ' Ajoute "-OK" dans la référence abonnement pour indiquer qu'il est prélevé
                szSQL = "CALL spUPD_ELEVES_CREDIT_WEB(" & cd_cli & ",'" & Format(DateAdd("m", 2, firstDatePrelev), "yyyy/MM/dd") & "'," & GetTicketMontant(email) & ",'" & _
                         ticketReference & "-3');"
                ExecQuery(ctDSN_AEM, szSQL)
            End If
        End If

        ' copie le ticket dans la table tickets_cb
        szSQL = "CALL spINS_TICKETS_CB('" & GetTicketEmail(email) & "','" & email.Subject & "','" & ticketDate & "','" & ticketReference & "'," & GetTicketMontant(email) & ",'" & _
                                        GetTicketAutorisation(email) & "','" & ticketReference & "');"
        ExecQuery(ctDSN_AEM, szSQL)

    End Sub

    Private Sub TraiterTicketErreur(email As Chilkat.Email)
        Dim ErreurMsg As String

        '  Set the SMTP server/login/password (if required)
        mailman.SmtpHost = My.Settings.SmtpHost
        mailman.SmtpUsername = My.Settings.SmtpUsername
        mailman.SmtpPassword = My.Settings.SmtpPassword

        '  Clear the To and CC email recipients.
        email.ClearTo()
        email.ClearCC()

        email.From = "TPE web <tpeweb@marietton.com>"
        '  Add the recipient to receive the forwarded email:
        email.AddTo("Comptabilite", My.Settings.SmtpUsername)
        email.AddTo("ctphuoc", "ctphuoc@gmail.com")

        ' forward the mail
        iDeb = mailman.SendEmail(email)
        If (iDeb <> True) Then
            ExecQuery(ctDSN_AEM, "CALL spINS_T_LOG('aem_CB','" & nq(mailman.LastErrorText) & "');")
            Exit Sub
        End If

        '  Some SMTP servers do not actually send the email until
        '  the connection is closed.  In these cases, it is necessary to
        '  call CloseSmtpConnection for the mail to be  sent.
        '  Most SMTP servers send the email immediately, and it is
        '  not required to close the connection.  We'll close it here
        '  for the example:
        mailman.CloseSmtpConnection()

        ' errur PAYBOX
        iDeb = InStr(email.Body, "Erreur :") + 8
        iFin = InStr(iDeb, email.Body, vbCr)
        ErreurMsg = Trim(Mid(email.Body, iDeb, iFin - iDeb))

        ' copie le ticket dans la table tickets_cb
        szSQL = "CALL spINS_TICKETS_CB('" & GetTicketEmail(email) & "','" & nq(Left(ErreurMsg, 50)) & "','" & Format(Now(), "yyyy/MM/dd") & "','" & GetRefCommande(email) & "',0,'','');"
        ExecQuery(ctDSN_AEM, szSQL)

    End Sub

    Private Function GetTicketAutorisation(email As Chilkat.Email) As String
        ' retourne le numéro d'autorisation
        ' ex: AUTO:     478055

        iDeb = InStr(email.Body, "AUTO:") + 5
        iFin = InStr(iDeb, email.Body, vbCr)
        GetTicketAutorisation = Trim(Mid(email.Body, iDeb, iFin - iDeb))

    End Function

    Private Function GetTicketDate(email As Chilkat.Email) As String
        ' retourne l'email du client

        ' ex:  le 04/11/2013 à 11:31
        iDeb = InStr(email.Body, "le ") + 3
        iFin = InStr(iDeb, email.Body, vbCr)
        GetTicketDate = Mid(email.Body, iDeb, iFin - iDeb)
        ' si la ligne contient " à ", OK
        If InStr(GetTicketDate, " à ") Then
            Exit Function
        Else
            ' sinon cherche le 2ème " le "
            iDeb = InStr(iFin, email.Body, " le ") + 4
            iFin = InStr(iDeb, email.Body, vbCr)
            GetTicketDate = Mid(email.Body, iDeb, iFin - iDeb)
        End If

    End Function

    Private Function GetTicketEmail(email As Chilkat.Email) As String
        ' retourne l'email du client
        ' ex: Email client: e.coutureau@cnic.u-bordeaux1.fr

        iDeb = InStr(email.Body, "Email client:") + 14
        iFin = InStr(iDeb, email.Body, vbCr)
        GetTicketEmail = Trim(Mid(email.Body, iDeb, iFin - iDeb))

    End Function

    Private Function GetTicketMontant(email As Chilkat.Email) As Decimal
        ' retourne le montant du ticket

        ' ex: MONTANT =        9.89 EUR
        iDeb = InStr(email.Body, "MONTANT =") + 9
        iFin = InStr(iDeb, email.Body, " EUR")
        GetTicketMontant = CDec(Replace(Mid(email.Body, iDeb, iFin - iDeb), Chr(&HA0), " "))

    End Function

    Private Function GetRefCommande(email As Chilkat.Email) As String
        ' retourne la Ref abonnement PAYBOX
        ' ex: Ref abonnement PAYBOX:209113862

        iDeb = InStr(email.Body, "Ref commande:") + 13
        iFin = InStr(iDeb, email.Body, vbCr)
        GetRefCommande = Trim(Mid(email.Body, iDeb, iFin - iDeb))

    End Function

    ' Tester la connection avec la base de données
    Private Function IsConnectionOK() As Boolean

        Dim conn As ADODB.Connection

        'enable error handler
        On Error GoTo ErrorHandler

        IsConnectionOK = False
        conn = New ADODB.Connection

        ' tester la connection avec MySQL
        conn.Open(ctDSN_AEM)
        conn.Close()
        ' conn.Dispose()
        IsConnectionOK = True
        Exit Function

ErrorHandler:
        szSQL = "CALL spINS_T_LOG('aem_CB','Erreur lors de la connection à la BD : " & Err.Number & ":" & Err.Description & "');"
        ExecQuery(ctDSN_AEM, szSQL)
        End

    End Function


End Module
